home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / LAGUER.DEM < prev    next >
Text File  |  1991-04-29  |  1KB  |  58 lines
  1. PROGRAM d9r10(input,output);
  2. (* driver for routine LAGUER *)
  3. CONST
  4.    m=4;
  5.    twomp2=10;   (* twomp2=2*m+2 *)
  6.    ntry=21;
  7.    twontry=42;   (* twontry=2*ntry *)
  8.    eps=1.0e-6;
  9. TYPE
  10.    glcarray = ARRAY [1..twomp2] OF real;
  11.    gl2array = ARRAY [1..2] OF real;
  12. VAR
  13.    i,iflag,j,n : integer;
  14.    polish : boolean;
  15.    x : gl2array;
  16.    a : glcarray;
  17.    y : ARRAY [1..twontry] OF real;
  18.  
  19. (*$I MODFILE.PAS *)
  20. (*$I LAGUER.PAS *)
  21.  
  22. BEGIN
  23.    a[1] := 0.0; a[2] := 2.0;
  24.    a[3] := 0.0; a[4] := 0.0;
  25.    a[5] := -1.0; a[6] := -2.0;
  26.    a[7] := 0.0; a[8] := 0.0;
  27.    a[9] := 1.0; a[10] := 0.0;
  28.    writeln;
  29.    writeln('Roots of polynomial x^4-(1+2i)*x^2+2i');
  30.    writeln('real':15,'complex':13);
  31.    n := 0;
  32.    polish := false;
  33.    FOR i := 1 to ntry DO BEGIN
  34.       x[1] := (i-11.0)/10.0;
  35.       x[2] := (i-11.0)/10.0;
  36.       laguer(a,m,x,eps,polish);
  37.       IF (n = 0) THEN BEGIN
  38.          n := 1;
  39.          y[1] := x[1];
  40.          y[2] := x[2];
  41.          writeln(n:5,x[1]:12:6,x[2]:12:6)
  42.       END ELSE BEGIN
  43.          iflag := 0;
  44.          FOR j := 1 to n DO BEGIN
  45.             IF (sqrt(sqr(x[1]-y[2*j-1])+sqr(x[2]-y[2*j]))
  46.                <= eps*sqrt(sqr(x[1])+sqr(x[2]))) THEN
  47.                iflag := 1            
  48.          END;
  49.          IF (iflag = 0) THEN BEGIN
  50.             n := n+1;
  51.             y[2*n-1] := x[1];
  52.             y[2*n] := x[2];
  53.             writeln(n:5,x[1]:12:6,x[2]:12:6)
  54.          END
  55.       END
  56.    END
  57. END.
  58.